home *** CD-ROM | disk | FTP | other *** search
- unit Timerit;
- {*******************************}
- { Author: Eric Uber }
- { CIS Account: 71102,3034 }
- { Written: June 14th 1995. }
- { Freeware, distribute at will. }
- {*******************************}
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, Extctrls;
-
- type
- TNotifyTickEvent = procedure(sender: TObject; iCurrentTick: integer) of object;
-
- TTimerIterate = class(TTimer)
- private
- { Private declarations }
- iCurrentTick: integer;
- fNumTicks: integer;
- fOnLastTick : TNotifyTickEvent;
- protected
- { Protected declarations }
- procedure SetfNumTicks(iNumTicks: integer);
- procedure Timer; override;
- public
- { Public declarations }
-
- published
- { Published declarations }
- property NumTicks : integer read fNumTicks write SetfNumTicks;
- property OnLastTick : TNotifyTickEvent read fOnLastTick write fOnLastTick;
- end;
-
- procedure Register;
-
- implementation
-
- {-----------------------------------------------}
- { Method: }
- {-----------------------------------------------}
- procedure Register;
- begin
- RegisterComponents('Custom', [TTimerIterate]);
- end;
-
- {-----------------------------------------------}
- { Method: }
- {-----------------------------------------------}
- procedure TTimerIterate.SetfNumTicks(iNumTicks: integer);
- begin
- fNumTicks := iNumTicks;
- iCurrentTick := fNumTicks;
- end;
-
- procedure TTimerIterate.Timer;
- begin
- if iCurrentTick = 0 then
- begin
- Enabled := False;
- iCurrentTick := fNumTicks;
- end
- else
- begin
- inherited Timer;
- Dec(iCurrentTick);
- if ( iCurrentTick = 0 ) then
- begin
- if Assigned(fOnLastTick) then
- fOnLastTick(self,(iCurrentTick+1));
- end
- end;
- end;
-
-
- end.
-